
let test_cases : (string * (unit -> unit)) list ref = ref [];;
let subprograms : (string * (unit -> unit)) list ref = ref [];;

let add_test_case name func =
  if List.exists (fun (n, _) -> n = name) !test_cases then
    failwith ("test case " ^ name ^ " registered twice")
  else
    test_cases := !test_cases @ [(name, func)];;

let add_subprogram name func =
  if List.exists (fun (n, _) -> n = name) !subprograms then
    failwith ("subprogram " ^ name ^ " registered twice")
  else
    subprograms := !subprograms @ [(name, func)];;

let test_case_names () =
  List.map (fun (n, _) -> n) !test_cases;;

let subprogram_names () =
  List.map (fun (n, _) -> n) !subprograms;;

let run_test_case name =
  let _, func = List.find (fun (n, _) -> n = name) !test_cases in
  print_endline ("Running test case \"" ^ name ^ "\"...");
  func ();
  print_endline ("Passed test case \"" ^ name ^ "\"");;
    
let run_subprogram name =
  let _, func = List.find (fun (n, _) -> n = name) !subprograms in
    func ();;
    
let subprogram_cmd n = (Array.get Sys.argv 0) ^ " run_subprogram " ^ n;;

let prerr_usage () =
  let prog = Filename.basename (Array.get Sys.argv 0) in
    prerr_endline
      ("Usage:\n" ^
       "\n" ^
       " " ^ prog ^ "\n" ^
       "   Runs all test cases.\n" ^
       "\n" ^
       " " ^ prog ^ " help\n" ^
       "   Displays this message.\n" ^
       "\n" ^
       " " ^ prog ^ " run_test <test_name>\n" ^
       "   Runs the named test case.  Supported test names:\n" ^
       "     " ^ (String.concat "\n     " (test_case_names ())) ^ "\n" ^
       "\n" ^
       " " ^ prog ^ " run_subprogram <subprogram_name>\n" ^
       "   Runs the named test case.  Supported test names:\n" ^
       "     " ^ (String.concat "\n     " (subprogram_names ())) ^ "\n");;
       
       

let run argv =
  match argv with
    | [| _ |] ->
        print_endline "Running all tests...";
        List.iter run_test_case (test_case_names ());
        print_endline "Passed all tests.";
    | [| _; "run_test"; test_name |] ->
        run_test_case test_name
    | [| _; "run_subprogram"; subprogram_name |] ->
        run_subprogram subprogram_name
    | [| _; "help" |] -> prerr_usage ()
    | _ -> prerr_usage ();;
